home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / LISP04.ARJ / CLOUD.LSP < prev    next >
Text File  |  1990-10-16  |  1KB  |  48 lines
  1. (defun c:cloud (/ head hdata bulge ed en)
  2.        (defun dxf (code elist)
  3.          (cdr (assoc code elist))
  4.        );defun
  5. (defun ustr (bit msg def spflag / inp nval)
  6.   (if (and def (/= def ""))
  7.    (setq msg (strcat "\n" msg " <" def ">: ")
  8.        inp (getstring msg spflag)
  9.        inp (if (= inp "") def inp)
  10.    );setq
  11.    (progn
  12.       (setq msg (strcat "\n" msg ": "))
  13.       (if (= bit 1)
  14.           (while (= "" (setq inp (getstring msg spflag))))
  15.           (setq inp (getstring msg spflag))
  16.    ));progn&if
  17.   );if
  18.   inp
  19. );defun
  20. (setvar "cmdecho" 0)
  21. (setvar "skpoly" 1)
  22. (setq ridef ri)
  23. (if (= ridef nil) (setq ridef "3/16"))
  24. (setq ri (ustr 0 "Record increment " ridef nil))
  25. (setvar "cmdecho" 1)
  26. (command "sketch" ri)
  27.   (if (and
  28.         (setq en (entlast))
  29.         (= (dxf 0 (setq hdata (entget en))) "POLYLINE")
  30.       );and
  31.     (progn
  32.       (entmod (subst '(70 . 1) '(70 . 0) hdata))
  33.       (setq bulge (list (cons 42 0.5)))
  34.       (setq en (dxf -1 hdata))
  35.         (while (and (setq en (entnext en))
  36.                     (setq ed (entget en))
  37.                     (/= "SEQEND" (dxf 0 ed))
  38.                );and
  39.                (setq ed (append ed bulge))
  40.                (entmod ed)
  41.          );while
  42.       (entupd en)
  43.     );progn
  44.    );if
  45.    (princ)
  46. );defun
  47. (princ)
  48.